home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
prog_bas
/
pbc32.zip
/
PBC$BAS.ZIP
/
BOXMENU1.BAS
< prev
next >
Wrap
BASIC Source File
|
1996-04-10
|
13KB
|
342 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone (C) Copyright 1996 Charon Software, All Rights Reserved |
' | |
' +----------------------------------------------------------------------+
DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
DECLARE SUB Delay18th (BYVAL WaitTime%)
DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
DECLARE FUNCTION GetCRT2% ()
DECLARE FUNCTION GetEGA2% ()
DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
DECLARE SUB GetMouseLoc (Row%, Column%)
DECLARE FUNCTION GetVGA2% ()
DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
DECLARE SUB MMButton3 (LeftB%, MidB%, RightB%)
DECLARE SUB MMCursorOff ()
DECLARE SUB MMCursorOn ()
DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)
SUB BoxMenu1 (Mouse%, PickList$(), Picked%(), Marker$, TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, ItemListAttr%, HiliteAttr%, TitleFore%, Title$, Grow%, Shade%, Picks%)
CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
IF Visible% THEN LOCATE , , 0
IF LEN(Marker$) > 1 THEN
LMarker$ = LEFT$(Marker$, 1)
RMarker$ = MID$(Marker$, 2, 1)
ELSE
LMarker$ = "<"
RMarker$ = ">"
END IF
LastItem% = 0
Columns% = 0
Picks% = 0
t1% = UBOUND(PickList$, 1)
FOR tmp% = t1% TO 1 STEP -1
t2% = LEN(PickList$(tmp%))
IF t2% THEN
IF LastItem% = 0 THEN LastItem% = tmp%
IF Columns% < t2% THEN Columns% = t2%
IF Picked%(tmp%) THEN Picks% = Picks% + 1
END IF
NEXT
IF LastItem% THEN
Columns% = Columns% + 2
IF Columns% > 75 THEN Columns% = 75
FOR tmp% = 1 TO LastItem%
IF LEN(PickList$(tmp%)) = 0 THEN Picked%(tmp%) = 0
NEXT
ELSE
Columns% = 14
END IF
GetVidMode VMode%, Cols%, Page% ' use active display page
IF GetCRT2% THEN ' use fast display unless CGA
IF GetEGA2% OR GetVGA2% THEN
Fast% = -1
ELSE
Fast% = 0
END IF
ELSE
Fast% = -1
END IF
RightCol% = LeftCol% + Columns% - 1 ' set right column
Rows% = BottomRow% - TopRow% + 1 ' and number of rows
IF Shade% THEN
CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
' this size works regardless of on which side the shadow is displayed...
ELSE
CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
END IF
DIM SavedScreen%(Words%)
TopRec% = 1
HiliteRow% = 1
'--- save the screen
IF Mouse% THEN MMCursorOff
DSeg% = VARSEG(SavedScreen%(1))
DOfs% = VARPTR(SavedScreen%(1))
IF Shade% THEN
IF Shade% < -2 THEN
DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
ELSE
DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 3, BottomRow% + 2, RightCol% + 1, Page%, Fast%
END IF
ELSE
DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
END IF
UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleFore%, Title$, Page%, Fast%
IF Mouse% THEN MMCursorOn
GOSUB DisplayItems
DO
'--- get input from appropriate device(s)
IF LeftButton% THEN Delay18th 2
DO
IF Mouse% THEN MMButton3 LeftButton%, MidButton%, RightButton%
IF LeftButton% = 0 AND MidButton% = 0 AND RightButton% = 0 THEN
BIOSInkey AsciiCode%, ScanCode%
END IF
LOOP UNTIL LeftButton% OR MidButton% OR RightButton% OR AsciiCode% OR ScanCode%
'--- handle mouse input, if any
IF Mouse% THEN
IF RightButton% THEN
AsciiCode% = 27
ELSEIF (LastItem% < 1) AND (LeftButton% OR MidButton%) THEN
AsciiCode% = 27
ELSEIF MidButton% THEN
AsciiCode% = 13
ELSEIF LeftButton% THEN
GetMouseLoc MouseRow%, MouseCol%
IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
IF MouseCol% = RightCol% + 1 THEN
tmp% = SCREEN(MouseRow%, MouseCol%)
IF tmp% = 24 THEN
' convert to ^E (same as up arrow)
AsciiCode% = 5
ELSEIF tmp% = 25 THEN
' convert to ^X (same as down arrow)
AsciiCode% = 24
END IF
ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
IF MouseRow% - TopRow% + TopRec% <= LastItem% THEN
HiLiteRow% = MouseRow% - TopRow% + 1
AsciiCode% = 32
END IF
END IF
END IF
END IF
END IF
'--- handle keyboard input, if any
IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
IF AsciiCode% = 17 THEN ' ^Q WordStar key combo processing
GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
SELECT CASE AsciiCode%
CASE 3 ' ^QC converts to ^<PgDn>
AsciiCode% = 0
ScanCode% = 118
CASE 18 ' ^QR converts to ^<PgUp>
AsciiCode% = 0
ScanCode% = 132
CASE ELSE
AsciiCode% = 0
ScanCode% = 0
END SELECT
END IF
IF AsciiCode% = 0 AND ScanCode% = 71 THEN
' <HOME>
IF HiliteRow% > 1 THEN
HiliteRow% = 1
GOSUB DisplayItems
END IF
ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
' <END>
IF TopRec% + Rows% > LastItem% THEN
HiliteRow% = LastItem% - TopRec% + 1
ELSE
HiliteRow% = Rows%
END IF
GOSUB DisplayItems
ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
' <CTRL><PGDN>
TopRec% = LastItem% - Rows% + 1
IF TopRec% < 1 THEN TopRec% = 1
IF TopRec% + Rows% > LastItem% THEN
HiliteRow% = LastItem% - TopRec% + 1
ELSE
HiliteRow% = Rows%
END IF
GOSUB DisplayItems
ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
' <CTRL><PGUP>
IF TopRec% > 1 OR HiliteRow% > 1 THEN
TopRec% = 1
HiliteRow% = 1
GOSUB DisplayItems
END IF
ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
' ^C or PgDn
IF TopRec% + 2 * Rows% - 1 < LastItem% THEN
TopRec% = TopRec% + Rows%
ELSE
TopRec% = LastItem% - Rows% + 1
IF TopRec% < 1 THEN TopRec% = 1
END IF
IF TopRec% > LastItem% THEN TopRec% = LastItem%
IF TopRec% + HiliteRow% - 1 >= LastItem% THEN
HiliteRow% = LastItem% - TopRec% + 1
END IF
GOSUB DisplayItems
ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
' ^E or up arrow
IF HiliteRow% > 1 OR TopRec% > 1 THEN
IF HiliteRow% > 1 THEN
HiliteRow% = HiliteRow% - 1
ELSE
TopRec% = TopRec% - 1
END IF
GOSUB DisplayItems
END IF
ELSEIF AsciiCode% = 13 THEN
' <CR>
IF LastItem% < 1 THEN
AsciiCode% = 27
LemmeOuttaHere% = -1
ELSE
DonePicking% = -1
END IF
ELSEIF AsciiCode% = 24 OR AsciiCode% = 0 AND ScanCode% = 80 THEN
' ^X or down arrow
IF HiliteRow% < Rows% AND TopRec% + HiliteRow% - 1 < LastItem% THEN
HiliteRow% = HiliteRow% + 1
GOSUB DisplayItems
ELSE
IF TopRec% + Rows% - 1 < LastItem% THEN
TopRec% = TopRec% + 1
GOSUB DisplayItems
END IF
END IF
ELSEIF AsciiCode% = 18 OR AsciiCode% = 0 AND ScanCode% = 73 THEN
' ^R or PgUp
IF TopRec% > Rows% THEN
TopRec% = TopRec% - Rows%
GOSUB DisplayItems
ELSE
IF TopRec% > 1 THEN
TopRec% = 1
GOSUB DisplayItems
END IF
END IF
ELSEIF AsciiCode% = 27 THEN
' <ESC>
LemmeOuttaHere% = -1
ELSEIF AsciiCode% = 32 THEN
' <space>
IF TopRec% + HiLiteRow% - 1 <= LastItem% THEN
tmp% = TopRec% + HiLiteRow% - 1
Picked%(tmp%) = NOT Picked%(tmp%)
IF Picked%(tmp%) THEN
Picks% = Picks% + 1
ELSE
Picks% = Picks% - 1
END IF
GOSUB DisplayItems
END IF
ELSEIF AsciiCode% = 10 THEN
' <CTRL><CR>
FOR tmp% = 1 TO LastItem%
Picked%(tmp%) = -1
NEXT
Picks% = LastItem%
GOSUB DisplayItems
ELSEIF AsciiCode% = 127 THEN
' <CTRL><BACKSPACE>
FOR tmp% = 1 TO LastItem%
Picked%(tmp%) = 0
NEXT
Picks% = 0
GOSUB DisplayItems
END IF
END IF
LOOP UNTIL DonePicking% OR LemmeOuttaHere%
IF LemmeOuttaHere% AND Picks% THEN
FOR tmp% = 1 TO LastItem%
Picked%(tmp%) = 0
NEXT
Picks% = 0
END IF
'--- restore the screen
IF Mouse% THEN MMCursorOff
DSeg% = VARSEG(SavedScreen%(1))
DOfs% = VARPTR(SavedScreen%(1))
IF Shade% THEN
IF Shade% < -2 THEN
DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
ELSE
DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 3, BottomRow% + 2, RightCol% + 1, Page%, Fast%
END IF
ELSE
DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
END IF
IF Mouse% THEN MMCursorOn
IF Visible% THEN LOCATE , , 1
EXIT SUB
DisplayItems:
IF Mouse% THEN MMCursorOff
IF LastItem% < 1 THEN
XQPrint "...no items...", TopRow%, LeftCol%, HiliteAttr%, Page%, Fast%
ELSE
' update scroll bar as needed
IF Rows% < LastItem% THEN
FOR Row% = TopRow% TO BottomRow%
XQPrint CHR$(178), Row%, RightCol% + 1, FrameAttr%, Page%, Fast%
NEXT
IF TopRec% > 1 AND Rows% > 1 THEN
XQPrint CHR$(24), TopRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
END IF
IF TopRec% + Rows% - 1 < LastItem% AND Rows% > 0 THEN
XQPrint CHR$(25), BottomRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
END IF
END IF
' update item list
FOR Row% = 1 TO Rows%
tmp% = TopRec% + Row% - 1
IF tmp% <= LastItem% THEN
IF Picked%(tmp%) THEN
St$ = LMarker$ + LEFT$(LEFT$(PickList$(tmp%), Columns% - 2) + SPACE$(Columns%), Columns% - 2) + RMarker$
ELSE
St$ = LEFT$(" " + LEFT$(PickList$(tmp%), Columns% - 2) + SPACE$(Columns%), Columns%)
END IF
ELSE
St$ = SPACE$(Columns%)
END IF
IF Row% = HiliteRow% THEN
XQPrint St$, TopRow% + Row% - 1, LeftCol%, HiliteAttr%, Page%, Fast%
ELSE
XQPrint St$, TopRow% + Row% - 1, LeftCol%, ItemListAttr%, Page%, Fast%
END IF
NEXT
END IF
IF Mouse% THEN MMCursorOn
RETURN
END SUB